home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / TUT20.ZIP / TUTPRO20.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1995-12-14  |  19.4 KB  |  868 lines
  1. {$X+}
  2. USES Crt,GFX2;
  3.  
  4. CONST VGA = $A000;
  5.       maxpolys = 18;
  6.  
  7.             A : Array [1..maxpolys,1..4,1..3] of integer =
  8.         (
  9.          ((-10, -10, 10 ),
  10.           (10 , -10, 10 ),
  11.           (10 , 10 , 10 ),
  12.           (-10, 10 , 10 )),
  13.  
  14.          ((-10, 10 , -10),
  15.           (10 , 10 , -10),
  16.           (10 , -10, -10),
  17.           (-10, -10, -10)),
  18.  
  19.          ((-10, 10 , 10 ),
  20.           (-10, 10 , -10),
  21.           (-10, -10, -10),
  22.           (-10, -10, 10 )),
  23.  
  24.          ((10 , -10, 10 ),
  25.           (10 , -10, -10),
  26.           (10 , 10 , -10),
  27.           (10 , 10 , 10 )),
  28.  
  29.          ((10 , 10 , 10 ),
  30.           (10 , 10 , -10),
  31.           (-10, 10 , -10),
  32.           (-10, 10 , 10 )),
  33.  
  34.          ((-10, -10, 10 ),
  35.           (-10, -10, -10),
  36.           (10 , -10, -10),
  37.           (10 , -10, 10 )),
  38.  
  39. (*********)
  40.  
  41.          ((-10, -10,-20 ),
  42.           (10 , -10,-20 ),
  43.           (10 , 10 ,-20 ),
  44.           (-10, 10 ,-20 )),
  45.  
  46.          ((-10, 10 , -30),
  47.           (10 , 10 , -30),
  48.           (10 , -10, -30),
  49.           (-10, -10, -30)),
  50.  
  51.          ((-10, 10 ,-20 ),
  52.           (-10, 10 , -30),
  53.           (-10, -10, -30),
  54.           (-10, -10,-20 )),
  55.  
  56.          ((10 , -10,-20 ),
  57.           (10 , -10, -30),
  58.           (10 , 10 , -30),
  59.           (10 , 10 ,-20 )),
  60.  
  61.          ((10 , 10 ,-20 ),
  62.           (10 , 10 , -30),
  63.           (-10, 10 , -30),
  64.           (-10, 10 ,-20 )),
  65.  
  66.          ((-10, -10,-20 ),
  67.           (-10, -10, -30),
  68.           (10 , -10, -30),
  69.           (10 , -10,-20 )),
  70.  
  71. (*********)
  72.  
  73.          ((-30, -10, 10 ),
  74.           (-20, -10, 10 ),
  75.           (-20, 10 , 10 ),
  76.           (-30, 10 , 10 )),
  77.  
  78.          ((-30, 10 , -10),
  79.           (-20, 10 , -10),
  80.           (-20, -10, -10),
  81.           (-30, -10, -10)),
  82.  
  83.          ((-30, 10 , 10 ),
  84.           (-30, 10 , -10),
  85.           (-30, -10, -10),
  86.           (-30, -10, 10 )),
  87.  
  88.          ((-20, -10, 10 ),
  89.           (-20, -10, -10),
  90.           (-20, 10 , -10),
  91.           (-20, 10 , 10 )),
  92.  
  93.          ((-20, 10 , 10 ),
  94.           (-20, 10 , -10),
  95.           (-30, 10 , -10),
  96.           (-30, 10 , 10 )),
  97.  
  98.          ((-30, -10, 10 ),
  99.           (-30, -10, -10),
  100.           (-20, -10, -10),
  101.           (-20, -10, 10 ))
  102.         );  { The 3-D coordinates of our object ... stored as (X1,Y1,Z1), }
  103.             { (X2,Y2,Z2) ... for the 4 points of a poly }
  104.  
  105.       XOfs = 100;
  106.       YOfs = 160;
  107.  
  108.  
  109. Type Point = Record
  110.                x,y,z:integer;                { The data on every point we rotate}
  111.              END;
  112.  
  113.  
  114. VAR Lines : Array [1..maxpolys,1..4] of Point; { The base object to be rotated }
  115.     Translated : Array [1..maxpolys,1..4] of Point; { The rotated object }
  116.     centre, tcentre : Array [1..maxpolys] of Point;
  117.     Order : Array[1..maxpolys] of integer;
  118.     lookup : Array [0..360,1..2] of integer; { Our sin and cos lookup table }
  119.     poly : array [0..199,1..2] of integer;
  120.     ytopclip,ybotclip:integer;  {where to clip our polys to}
  121.     xoff,yoff,zoff:integer;
  122.  
  123.  
  124. {──────────────────────────────────────────────────────────────────────────}
  125. Procedure SetMCGA;  { This procedure gets you into 320x200x256 mode. }
  126. BEGIN
  127.   asm
  128.      mov        ax,0013h
  129.      int        10h
  130.   end;
  131. END;
  132.  
  133.  
  134. {──────────────────────────────────────────────────────────────────────────}
  135. Procedure Hline (x1,x2,y:integer;col:byte;where:word); assembler;
  136.   { This draws a horizontal line from x1 to x2 on line y in color col }
  137. asm
  138.   mov   ax,x1
  139.   cmp   ax,0
  140.   jge   @X1Okay
  141.   mov   x1,0
  142. @X1Okay :
  143.  
  144.   mov   ax,x2
  145.   cmp   ax,319
  146.   jle   @X2Okay
  147.   mov   x2,319
  148. @X2Okay :
  149.  
  150.   mov   ax,x1
  151.   cmp   ax,x2
  152.   jg    @Exit
  153.  
  154.   mov   ax,where
  155.   mov   es,ax
  156.   mov   ax,y
  157.   mov   di,ax
  158.   shl   ax,8
  159.   shl   di,6
  160.   add   di,ax
  161.   add   di,x1
  162.  
  163.   mov   al,col
  164.   mov   ah,al
  165.   mov   cx,x2
  166.   sub   cx,x1
  167.   shr   cx,1
  168.   jnc   @start
  169.   stosb
  170. @Start :
  171.   rep   stosw
  172. @Exit :
  173. end;
  174.  
  175.  
  176. {──────────────────────────────────────────────────────────────────────────}
  177. Procedure DrawPoly(x1,y1,x2,y2,x3,y3,x4,y4:integer;color:byte;where:word);
  178.   { This draw a polygon with 4 points at x1,y1 , x2,y2 , x3,y3 , x4,y4
  179.     in color col }
  180. var miny,maxy:integer;
  181.     loop1:integer;
  182.  
  183. Procedure doside (x1,y1,x2,y2:integer);
  184.   { This scans the side of a polygon and updates the poly variable }
  185. VAR temp:integer;
  186.     x,xinc:integer;
  187.     loop1:integer;
  188. BEGIN
  189.   if y1=y2 then exit;
  190.   if y2<y1 then BEGIN
  191.     temp:=y2;
  192.     y2:=y1;
  193.     y1:=temp;
  194.     temp:=x2;
  195.     x2:=x1;
  196.     x1:=temp;
  197.   END;
  198.   xinc:=((x2-x1) shl 7) div (y2-y1);
  199.   x:=x1 shl 7;
  200.   for loop1:=y1 to y2 do BEGIN
  201.     if (loop1>(ytopclip)) and (loop1<(ybotclip)) then BEGIN
  202.       if (x shr 7<poly[loop1,1]) then poly[loop1,1]:=x shr 7;
  203.       if (x shr 7>poly[loop1,2]) then poly[loop1,2]:=x shr 7;
  204.     END;
  205.     x:=x+xinc;
  206.   END;
  207. END;
  208.  
  209. begin
  210.   asm
  211.     mov   si,offset poly
  212.     mov   cx,200
  213. @Loop1:
  214.     mov   ax,32766
  215.     mov   ds:[si],ax
  216.     inc   si
  217.     inc   si
  218.     mov   ax,-32767
  219.     mov   ds:[si],ax
  220.     inc   si
  221.     inc   si
  222.     loop  @loop1
  223.   end;     { Setting the minx and maxx values to extremes }
  224.   miny:=y1;
  225.   maxy:=y1;
  226.   if y2<miny then miny:=y2;
  227.   if y3<miny then miny:=y3;
  228.   if y4<miny then miny:=y4;
  229.   if y2>maxy then maxy:=y2;
  230.   if y3>maxy then maxy:=y3;
  231.   if y4>maxy then maxy:=y4;
  232.   if miny<ytopclip then miny:=ytopclip;
  233.   if maxy>ybotclip then maxy:=ybotclip;
  234.   if (miny>199) or (maxy<0) then exit;
  235.  
  236.   Doside (x1,y1,x2,y2);
  237.   Doside (x2,y2,x3,y3);
  238.   Doside (x3,y3,x4,y4);
  239.   Doside (x4,y4,x1,y1);
  240.  
  241.   for loop1:= miny to maxy do
  242.     hline (poly[loop1,1],poly[loop1,2],loop1,color,where);
  243. end;
  244.  
  245.  
  246. {──────────────────────────────────────────────────────────────────────────}
  247. Procedure SetUpPoints;
  248.   { This creates the lookup table }
  249. VAR loop1,loop2:integer;
  250. BEGIN
  251.   For loop1:=0 to 360 do BEGIN
  252.     lookup [loop1,1]:=round(sin (rad (loop1))*16384);
  253.     lookup [loop1,2]:=round(cos (rad (loop1))*16384);
  254.   END;
  255.   For loop1:=1 to maxpolys do BEGIN
  256.     centre[loop1].x := (lines[loop1,1].x + lines[loop1,2].x +
  257.                         lines[loop1,3].x + lines[loop1,4].x) div 4;
  258.     centre[loop1].y := (lines[loop1,1].y + lines[loop1,2].y +
  259.                         lines[loop1,3].y + lines[loop1,4].y) div 4;
  260.     centre[loop1].z := (lines[loop1,1].z + lines[loop1,2].z +
  261.                         lines[loop1,3].z + lines[loop1,4].z) div 4;
  262.   END;
  263. END;
  264.  
  265.  
  266. {──────────────────────────────────────────────────────────────────────────}
  267. Procedure RotatePoints (x,Y,z:Integer);
  268.   { This rotates the objecct in lines to translated }
  269. VAR loop1,loop2:integer;
  270.     a,b,c:integer;
  271. BEGIN
  272.   For loop1:=1 to maxpolys do BEGIN
  273.     for loop2:=1 to 4 do BEGIN
  274.       b:=lookup[y,2];
  275.       c:=lines[loop1,loop2].x;
  276.       asm
  277.         mov   ax,b
  278.         imul  c
  279.         sal   ax,1
  280.         rcl   dx,1
  281.         sal   ax,1
  282.         rcl   dx,1
  283.         mov   a,dx
  284.       end;
  285.       b:=lookup[y,1];
  286.       c:=lines[loop1,loop2].z;
  287.       asm
  288.         mov   ax,b
  289.         imul  c
  290.         sal   ax,1
  291.         rcl   dx,1
  292.         sal   ax,1
  293.         rcl   dx,1
  294.         add   a,dx
  295.       end;
  296.       translated[loop1,loop2].x:=a;
  297.       translated[loop1,loop2].y:=lines[loop1,loop2].y;
  298.       b:=-lookup[y,1];
  299.       c:=lines[loop1,loop2].x;
  300.       asm
  301.         mov   ax,b
  302.         imul  c
  303.         sal   ax,1
  304.         rcl   dx,1
  305.         sal   ax,1
  306.         rcl   dx,1
  307.         mov   a,dx
  308.       end;
  309.       b:=lookup[y,2];
  310.       c:=lines[loop1,loop2].z;
  311.       asm
  312.         mov   ax,b
  313.         imul  c
  314.         sal   ax,1
  315.         rcl   dx,1
  316.         sal   ax,1
  317.         rcl   dx,1
  318.         add   a,dx
  319.       end;
  320.       translated[loop1,loop2].z:=a;
  321.  
  322.  
  323.       if x<>0 then BEGIN
  324.         b:=lookup[x,2];
  325.         c:=translated[loop1,loop2].y;
  326.         asm
  327.           mov   ax,b
  328.           imul  c
  329.           sal   ax,1
  330.           rcl   dx,1
  331.           sal   ax,1
  332.           rcl   dx,1
  333.           mov   a,dx
  334.         end;
  335.         b:=lookup[x,1];
  336.         c:=translated[loop1,loop2].z;
  337.         asm
  338.           mov   ax,b
  339.           imul  c
  340.           sal   ax,1
  341.           rcl   dx,1
  342.           sal   ax,1
  343.           rcl   dx,1
  344.           sub   a,dx
  345.         end;
  346.         b:=lookup[x,1];
  347.         c:=translated[loop1,loop2].y;
  348.         translated[loop1,loop2].y:=a;
  349.         asm
  350.           mov   ax,b
  351.           imul  c
  352.           sal   ax,1
  353.           rcl   dx,1
  354.           sal   ax,1
  355.           rcl   dx,1
  356.           mov   a,dx
  357.         end;
  358.         b:=lookup[x,2];
  359.         c:=translated[loop1,loop2].z;
  360.         asm
  361.           mov   ax,b
  362.           imul  c
  363.           sal   ax,1
  364.           rcl   dx,1
  365.           sal   ax,1
  366.           rcl   dx,1
  367.           add   a,dx
  368.         end;
  369.         translated[loop1,loop2].z:=a;
  370.       END;
  371.  
  372.  
  373.  
  374.  
  375.       if z<>0 then BEGIN
  376.         b:=lookup[z,2];
  377.         c:=translated[loop1,loop2].x;
  378.         asm
  379.           mov   ax,b
  380.           imul  c
  381.           sal   ax,1
  382.           rcl   dx,1
  383.           sal   ax,1
  384.           rcl   dx,1
  385.           mov   a,dx
  386.         end;
  387.         b:=lookup[z,1];
  388.         c:=translated[loop1,loop2].y;
  389.         asm
  390.           mov   ax,b
  391.           imul  c
  392.           sal   ax,1
  393.           rcl   dx,1
  394.           sal   ax,1
  395.           rcl   dx,1
  396.           sub   a,dx
  397.         end;
  398.         b:=lookup[z,1];
  399.         c:=translated[loop1,loop2].x;
  400.         translated[loop1,loop2].x:=a;
  401.         asm
  402.           mov   ax,b
  403.           imul  c
  404.           sal   ax,1
  405.           rcl   dx,1
  406.           sal   ax,1
  407.           rcl   dx,1
  408.           mov   a,dx
  409.         end;
  410.         b:=lookup[z,2];
  411.         c:=translated[loop1,loop2].y;
  412.         asm
  413.           mov   ax,b
  414.           imul  c
  415.           sal   ax,1
  416.           rcl   dx,1
  417.           sal   ax,1
  418.           rcl   dx,1
  419.           add   a,dx
  420.         end;
  421.         translated[loop1,loop2].y:=a;
  422.       END;
  423.     END;
  424.   END;
  425.  
  426.  
  427. {******************}
  428.   For loop1:=1 to maxpolys do BEGIN
  429.     b:=lookup[y,2];
  430.     c:=centre[loop1].x;
  431.     asm
  432.       mov   ax,b
  433.       imul  c
  434.       sal   ax,1
  435.       rcl   dx,1
  436.       sal   ax,1
  437.       rcl   dx,1
  438.       mov   a,dx
  439.     end;
  440.     b:=lookup[y,1];
  441.     c:=centre[loop1].z;
  442.     asm
  443.       mov   ax,b
  444.       imul  c
  445.       sal   ax,1
  446.       rcl   dx,1
  447.       sal   ax,1
  448.       rcl   dx,1
  449.       add   a,dx
  450.     end;
  451.     tcentre[loop1].x:=a;
  452.     tcentre[loop1].y:=centre[loop1].y;
  453.     b:=-lookup[y,1];
  454.     c:=centre[loop1].x;
  455.     asm
  456.       mov   ax,b
  457.       imul  c
  458.       sal   ax,1
  459.       rcl   dx,1
  460.       sal   ax,1
  461.       rcl   dx,1
  462.       mov   a,dx
  463.     end;
  464.     b:=lookup[y,2];
  465.     c:=centre[loop1].z;
  466.     asm
  467.       mov   ax,b
  468.       imul  c
  469.       sal   ax,1
  470.       rcl   dx,1
  471.       sal   ax,1
  472.       rcl   dx,1
  473.       add   a,dx
  474.     end;
  475.     tcentre[loop1].z:=a;
  476.  
  477.  
  478.     if x<>0 then BEGIN
  479.       b:=lookup[x,2];
  480.       c:=tcentre[loop1].y;
  481.       asm
  482.         mov   ax,b
  483.         imul  c
  484.         sal   ax,1
  485.         rcl   dx,1
  486.         sal   ax,1
  487.         rcl   dx,1
  488.         mov   a,dx
  489.       end;
  490.       b:=lookup[x,1];
  491.       c:=tcentre[loop1].z;
  492.       asm
  493.         mov   ax,b
  494.         imul  c
  495.         sal   ax,1
  496.         rcl   dx,1
  497.         sal   ax,1
  498.         rcl   dx,1
  499.         sub   a,dx
  500.       end;
  501.       b:=lookup[x,1];
  502.       c:=tcentre[loop1].y;
  503.       tcentre[loop1].y:=a;
  504.       asm
  505.         mov   ax,b
  506.         imul  c
  507.         sal   ax,1
  508.         rcl   dx,1
  509.         sal   ax,1
  510.         rcl   dx,1
  511.         mov   a,dx
  512.       end;
  513.       b:=lookup[x,2];
  514.       c:=tcentre[loop1].z;
  515.       asm
  516.         mov   ax,b
  517.         imul  c
  518.         sal   ax,1
  519.         rcl   dx,1
  520.         sal   ax,1
  521.         rcl   dx,1
  522.         add   a,dx
  523.       end;
  524.       tcentre[loop1].z:=a;
  525.     END;
  526.  
  527.  
  528.  
  529.  
  530.     if z<>0 then BEGIN
  531.       b:=lookup[z,2];
  532.       c:=tcentre[loop1].x;
  533.       asm
  534.         mov   ax,b
  535.         imul  c
  536.         sal   ax,1
  537.         rcl   dx,1
  538.         sal   ax,1
  539.         rcl   dx,1
  540.         mov   a,dx
  541.       end;
  542.       b:=lookup[z,1];
  543.       c:=tcentre[loop1].y;
  544.       asm
  545.         mov   ax,b
  546.         imul  c
  547.         sal   ax,1
  548.         rcl   dx,1
  549.         sal   ax,1
  550.         rcl   dx,1
  551.         sub   a,dx
  552.       end;
  553.       b:=lookup[z,1];
  554.       c:=tcentre[loop1].x;
  555.       tcentre[loop1].x:=a;
  556.       asm
  557.         mov   ax,b
  558.         imul  c
  559.         sal   ax,1
  560.         rcl   dx,1
  561.         sal   ax,1
  562.         rcl   dx,1
  563.         mov   a,dx
  564.       end;
  565.       b:=lookup[z,2];
  566.       c:=tcentre[loop1].y;
  567.       asm
  568.         mov   ax,b
  569.         imul  c
  570.         sal   ax,1
  571.         rcl   dx,1
  572.         sal   ax,1
  573.         rcl   dx,1
  574.         add   a,dx
  575.       end;
  576.       tcentre[loop1].y:=a;
  577.     END;
  578.   END;
  579. END;
  580.  
  581.  
  582.  
  583. {──────────────────────────────────────────────────────────────────────────}
  584. Procedure DrawPoints;
  585.   { This draws the translated object to the virtual screen }
  586. VAR loop1,loop2:Integer;
  587.     temp, normal:integer;
  588.     nx:integer;
  589.     tx1,ty1,tx2,ty2,tx3,ty3,tx4,ty4:integer;
  590. BEGIN
  591.   For loop2:=1 to maxpolys do BEGIN
  592.     loop1:=order[loop2];
  593.     If (translated[loop1,1].z+zoff<0) and (translated[loop1,2].z+zoff<0)
  594.        and (translated[loop1,3].z+zoff<0) and (translated[loop1,4].z+zoff<0)
  595.        then BEGIN
  596.       temp:=round (translated[loop1,1].z)+zoff;
  597.       nx:=translated[loop1,1].X;
  598.       asm
  599.         mov   ax,nx
  600.         mov   dx,ax
  601.         sal   ax,8
  602.         sar   dx,8
  603.         idiv  temp
  604.         add   ax,YOfs
  605.         mov   nx,ax
  606.       end;
  607.       tx1:=nx;
  608.       nx:=translated[loop1,1].Y;
  609.       asm
  610.         mov   ax,nx
  611.         mov   dx,ax
  612.         sal   ax,8
  613.         sar   dx,8
  614.         idiv  temp
  615.         add   ax,XOfs
  616.         mov   nx,ax
  617.       end;
  618.       ty1:=nx;
  619.  
  620.  
  621.       temp:=round (translated[loop1,2].z)+zoff;
  622.       nx:=translated[loop1,2].X;
  623.       asm
  624.         mov   ax,nx
  625.         mov   dx,ax
  626.         sal   ax,8
  627.         sar   dx,8
  628.         idiv  temp
  629.         add   ax,YOfs
  630.         mov   nx,ax
  631.       end;
  632.       tx2:=nx;
  633.       nx:=translated[loop1,2].Y;
  634.       asm
  635.         mov   ax,nx
  636.         mov   dx,ax
  637.         sal   ax,8
  638.         sar   dx,8
  639.         idiv  temp
  640.         add   ax,XOfs
  641.         mov   nx,ax
  642.       end;
  643.       ty2:=nx;
  644.  
  645.  
  646.       temp:=round (translated[loop1,3].z)+zoff;
  647.       nx:=translated[loop1,3].X;
  648.       asm
  649.         mov   ax,nx
  650.         mov   dx,ax
  651.         sal   ax,8
  652.         sar   dx,8
  653.         idiv  temp
  654.         add   ax,YOfs
  655.         mov   nx,ax
  656.       end;
  657.       tx3:=nx;
  658.       nx:=translated[loop1,3].Y;
  659.       asm
  660.         mov   ax,nx
  661.         mov   dx,ax
  662.         sal   ax,8
  663.         sar   dx,8
  664.         idiv  temp
  665.         add   ax,XOfs
  666.         mov   nx,ax
  667.       end;
  668.       ty3:=nx;
  669.  
  670.  
  671.       temp:=round (translated[loop1,4].z)+zoff;
  672.       nx:=translated[loop1,4].X;
  673.       asm
  674.         mov   ax,nx
  675.         mov   dx,ax
  676.         sal   ax,8
  677.         sar   dx,8
  678.         idiv  temp
  679.         add   ax,YOfs
  680.         mov   nx,ax
  681.       end;
  682.       tx4:=nx;
  683.       nx:=translated[loop1,4].Y;
  684.       asm
  685.         mov   ax,nx
  686.         mov   dx,ax
  687.         sal   ax,8
  688.         sar   dx,8
  689.         idiv  temp
  690.         add   ax,XOfs
  691.         mov   nx,ax
  692.       end;
  693.       ty4:=nx;
  694.  
  695.       normal:=(ty1-ty3)*(tx2-tx1)-(tx1-tx3)*(ty2-ty1);
  696.       if normal<0 then
  697.         drawpoly (tx1,ty1,tx2,ty2,tx3,ty3,tx4,ty4,loop1,vaddr);
  698.     END;
  699.   END;
  700. END;
  701.  
  702.  
  703.  
  704. {──────────────────────────────────────────────────────────────────────────}
  705. Procedure SortPoints;
  706. VAR loop1,curpos, temp:integer;
  707. BEGIN
  708.   for loop1:=1 to maxpolys do BEGIN
  709.     order[loop1]:=loop1;
  710.   END;
  711.   curpos := 1;
  712.   while curpos<maxpolys do BEGIN
  713.     if tcentre[curpos].z > tcentre[curpos+1].z then BEGIN
  714.       temp := tcentre[curpos+1].x;
  715.       tcentre[curpos+1].x := tcentre[curpos].x;
  716.       tcentre[curpos].x := temp;
  717.  
  718.       temp := tcentre[curpos+1].y;
  719.       tcentre[curpos+1].y := tcentre[curpos].y;
  720.       tcentre[curpos].y := temp;
  721.  
  722.       temp := tcentre[curpos+1].z;
  723.       tcentre[curpos+1].z := tcentre[curpos].z;
  724.       tcentre[curpos].z := temp;
  725.  
  726.       temp := order[curpos+1];
  727.       order[curpos+1] := order[curpos];
  728.       order[curpos] := temp;
  729.  
  730.       curpos:=0;
  731.     END;
  732.     curpos:=curpos+1;
  733.   END;
  734. END;
  735.  
  736.  
  737. {──────────────────────────────────────────────────────────────────────────}
  738. Procedure MoveAround;
  739.   { This is the main display procedure. }
  740. VAR deg,deg2,loop1,loop2:integer;
  741.     ch:char;
  742.  
  743. BEGIN
  744.   pal (1,  0, 0,63);
  745.   pal (2,  0,32,63);
  746.   pal (3, 32, 0,63);
  747.   pal (4, 32,32,63);
  748.   pal (5,  0,63,63);
  749.   pal (6, 32,63,63);
  750.  
  751.   pal ( 7,  0,63, 0);
  752.   pal ( 8,  0,63,32);
  753.   pal ( 9, 32,63, 0);
  754.   pal (10, 32,63,32);
  755.   pal (11,  0,63,63);
  756.   pal (12, 32,63,63);
  757.  
  758.   pal (13, 63, 0, 0);
  759.   pal (14, 63,32, 0);
  760.   pal (15, 63, 0,32);
  761.   pal (16, 63,32,32);
  762.   pal (17, 63,63, 0);
  763.   pal (18, 63,63,32);
  764. {  for loop1:=1 to 15 do
  765.     pal (loop1,0,loop1*4+3,63-(loop1*4+3));}
  766.   pal (100,50,50,50);
  767.  
  768.   deg:=0;
  769.   deg2:=0;
  770.   ch:=#0;
  771.   Cls (vaddr,0);
  772.   For loop1:=1 to maxpolys do
  773.     For loop2:=1 to 4 do BEGIN
  774.       Lines [loop1,loop2].x:=a [loop1,loop2,1]*8;
  775.       Lines [loop1,loop2].y:=a [loop1,loop2,2]*8;
  776.       Lines [loop1,loop2].z:=a [loop1,loop2,3]*8;
  777.     END;
  778.  
  779.   SetUpPoints;
  780.  
  781.   cls (vaddr,0);
  782.   cls (vga,0);
  783.   Xoff := 160;
  784.   Yoff:=100;
  785.   zoff:=-500;
  786.  
  787.   ytopclip:=101;
  788.   ybotclip:=100;
  789.   line (0,100,319,100,100,vga);
  790.   delay (2000);
  791.   for loop1:=1 to 25 do BEGIN
  792.     RotatePoints (deg2,deg,deg2);
  793.     SortPoints;
  794.     DrawPoints;
  795.     line (0,ytopclip,319,ytopclip,100,vaddr);
  796.     line (0,ybotclip,319,ybotclip,100,vaddr);
  797.     flip (vaddr,vga);
  798.     cls (vaddr,0);
  799.     deg:=(deg+5) mod 360;
  800.     deg2:=(deg2+1) mod 360;
  801.     ytopclip:=ytopclip-4;
  802.     ybotclip:=ybotclip+4;
  803.   END;
  804.   Repeat
  805.     if keypressed then ch:=upcase (Readkey);
  806.     RotatePoints (deg2,deg,deg2);
  807.     SortPoints;
  808.     DrawPoints;
  809.     line (0,0,319,0,100,vaddr);
  810.     line (0,199,319,199,100,vaddr);
  811.     flip (vaddr,vga);
  812.     cls (vaddr,0);
  813.     deg:=(deg+5) mod 360;
  814.     deg2:=(deg2+3) mod 360;
  815.   Until ch=#27;
  816.   for loop1:=1 to 25 do BEGIN
  817.     ytopclip:=ytopclip+4;
  818.     ybotclip:=ybotclip-4;
  819.     RotatePoints (deg2,deg,deg2);
  820.     SortPoints;
  821.     DrawPoints;
  822.     line (0,ytopclip,319,ytopclip,100,vaddr);
  823.     line (0,ybotclip,319,ybotclip,100,vaddr);
  824.     flip (vaddr,vga);
  825.     cls (vaddr,0);
  826.     deg:=(deg+5) mod 360;
  827.     deg2:=(deg2+1) mod 360;
  828.   END;
  829. END;
  830.  
  831.  
  832. BEGIN
  833.   clrscr;
  834.   writeln ('Welcome to the twentieth(sp) trainer! This one is on face sorting');
  835.   writeln ('and back face removal.');
  836.   writeln;
  837.   writeln ('Just hit a key to view the 3d shape. You will notice that you');
  838.   writeln ('won''t see any of the faces you shouldn''t see :-)');
  839.   writeln ('The code is based on that from the glenzing tut, so you should');
  840.   writeln ('be able to understand it fairly quickly.');
  841.   writeln;
  842.   writeln;
  843.   writeln;
  844.   write ('Hit any key to continue ...');
  845.   readkey;
  846.   SetUpVirtual;
  847.   SetMCGA;
  848.   MoveAround;
  849.   SetText;
  850.   ShutDown;
  851.   Writeln ('All done. This concludes the twentieth sample program in the ASPHYXIA');
  852.   Writeln ('Training series. You may reach DENTHOR under the names of GRANT');
  853.   Writeln ('SMITH/DENTHOR/ASPHYXIA on the ASPHYXIA BBS.I also occasinally');
  854.   Writeln ('RSAProg, comp.lang.pascal and comp.sys.ibm.pc.demos. E-mail me at :');
  855.   Writeln ('    denthor@goth.vironix.co.za');
  856.   Writeln ('The numbers are available in the main text. You may also write to me at:');
  857.   Writeln ('             Grant Smith');
  858.   Writeln ('             P.O. Box 270');
  859.   Writeln ('             Kloof');
  860.   Writeln ('             3640');
  861.   Writeln ('             Natal');
  862.   Writeln ('             South Africa');
  863.   Writeln ('I hope to hear from you soon!');
  864.   Writeln; Writeln;
  865.   Write   ('Hit any key to exit ...');
  866.   readkey;
  867. END.
  868.